Apra Data Science Challenge 2025

Load Libraries

packages <- c(
  'ggplot2','tidyverse','plotly','leaflet',
  'shiny','shinyWidgets','shinydashboard',
  'xts','forecast','TTR',
  'DT','lubridate','RColorBrewer','scales','stopwords',
  'tidytext','stringr','wordcloud','wordcloud2',
  'SnowballC','textmineR','topicmodels','textclean','tm'
)
for (package in packages) { 
  if (!require(package, character.only = T, quietly = T)) {
    install.packages(package)
    library(package, character.only = T)
  }
}

Load data

crm <- read_csv("CRM_interacions_table.csv")
gift <- read_csv("gift_transactions_table.csv")
video <- read_csv("video_email_data_table.csv")
constituent <- read_csv("constituent_profiles_table.csv")

Part 1: The Untapped Potential: Understanding Our Donor Landscape

CRM Data Overview

# CRM Interaction Type
g <- crm %>%
        group_by(CRM_INTERACTION_TYPE) %>%
        summarise(Total = n()) %>%
        select(CRM_INTERACTION_TYPE, Total) %>%
        ggplot(aes(x = reorder(CRM_INTERACTION_TYPE,Total) ,y = Total))  +
        geom_bar(stat = "identity",width = 0.5, fill='black')  +
        scale_y_continuous(labels = scales::comma) +
        labs(x ="CRM Interaction Type", y = "Count") + coord_flip() +
        theme(legend.text = element_text(size = 12),
              legend.title = element_text(size = 12),
              axis.title = element_text(size = 14),
              axis.text = element_text(size = 12))
      
ggplotly(g)

CRM Interaction Over Time

crm <- crm %>%
        mutate(Year = lubridate::year(CRM_INTERACTION_DATE),
               Quarter = lubridate::quarter(CRM_INTERACTION_DATE),
               Month = lubridate::month(CRM_INTERACTION_DATE, label = TRUE),
               DOW = lubridate::wday(CRM_INTERACTION_DATE, label=TRUE))

CRM Interaction by Year

crm_year <- crm %>%
group_by(Year, CRM_INTERACTION_TYPE) %>%
        summarise(Total = n()) %>%
        select(Year,CRM_INTERACTION_TYPE, Total)

   g <- ggplot(crm_year, aes(as.factor(Year), Total, group=CRM_INTERACTION_TYPE, colour = CRM_INTERACTION_TYPE)) + 
      geom_line( linewidth=1) + theme_minimal() +
      labs(x = "Year", y = "Total", color="CRM Interaction Type") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

CRM Interaction by Quarter

crm %>%
group_by(Quarter, CRM_INTERACTION_TYPE) %>%
        summarise(Total = n()) %>%
        select(Quarter,CRM_INTERACTION_TYPE, Total) %>% 
      ggplot(aes(as.factor(Quarter), Total, group=CRM_INTERACTION_TYPE, colour = CRM_INTERACTION_TYPE)) + 
      geom_line( linewidth=1) + theme_minimal() +
      labs(x = "Quarter", y = "Total", color="CRM Interaction Type") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))

CRM Interaction by Month

crm %>%
group_by(Month, CRM_INTERACTION_TYPE) %>%
        summarise(Total = n()) %>%
        select(Month,CRM_INTERACTION_TYPE, Total) %>% 
      ggplot(aes(as.factor(Month), Total, group=CRM_INTERACTION_TYPE, colour = CRM_INTERACTION_TYPE)) + 
      geom_line( linewidth=1) + theme_minimal() +
      labs(x = "Quarter", y = "Total", color="CRM Interaction Type") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))

CRM Interaction by Day of Week

crm %>%
group_by(DOW, CRM_INTERACTION_TYPE) %>%
        summarise(Total = n()) %>%
        select(DOW,CRM_INTERACTION_TYPE, Total) %>% 
      ggplot(aes(as.factor(DOW), Total, group=CRM_INTERACTION_TYPE, colour = CRM_INTERACTION_TYPE)) + 
      geom_line( linewidth=1) + theme_minimal() +
      labs(x = "Day of Week", y = "Total", color="CRM Interaction Type") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))

Gift Overview

Gifts by CRM Interaction Type

left_join(gift,crm,by='CONSTITUENT_ID') %>%
  group_by(CRM_INTERACTION_TYPE) %>%
  summarise(Total = sum(AMOUNT)) %>%
  select(CRM_INTERACTION_TYPE,Total) %>%
  ggplot(aes(x = reorder(CRM_INTERACTION_TYPE,Total) ,y = Total))  +
        geom_bar(stat = "identity",width = 0.5, fill='black')  +
        scale_y_continuous(labels = scales::comma) +
        labs(x ="CRM Interaction Type", y = "Donations") + coord_flip() +
        theme(legend.text = element_text(size = 12),
              legend.title = element_text(size = 12),
              axis.title = element_text(size = 14),
              axis.text = element_text(size = 12))

Gifts overtime

gift <- gift %>%
        mutate(Year = lubridate::year(GIFT_DATE),
               Quarter = lubridate::quarter(GIFT_DATE),
               Month = lubridate::month(GIFT_DATE, label = TRUE),
               DOW = lubridate::wday(GIFT_DATE, label=TRUE))

Gift by Year

g <- gift %>%
group_by(Year) %>%
        summarise(Total = sum(AMOUNT)) %>%
        select(Year, Total) %>% 
        na.omit() %>%
      ggplot(aes(Year, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Year", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 90, hjust = 1))
ggplotly(g)

Gift by Quarter

g <- gift %>%
group_by(Quarter) %>%
        summarise(Total = sum(AMOUNT)) %>%
        select(Quarter, Total) %>% 
        na.omit() %>%
      ggplot(aes(Quarter, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Quarter", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Gift by Month

g <- gift %>%
group_by(Month) %>%
        summarise(Total = sum(AMOUNT)) %>%
        select(Month, Total) %>% 
        na.omit() %>%
      ggplot(aes(Month, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Month", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Gift by Day of Week

g <- gift %>%
group_by(DOW) %>%
        summarise(Total = sum(AMOUNT)) %>%
        select(DOW, Total) %>% 
        na.omit() %>%
      ggplot(aes(DOW, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Day of Week", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Video Overview

Video Views over time

video <- video %>%
        mutate(Year = lubridate::year(SENT_DATE),
               Quarter = lubridate::quarter(SENT_DATE),
               Month = lubridate::month(SENT_DATE, label = TRUE),
               DOW = lubridate::wday(SENT_DATE, label=TRUE))

Video views by year

g <- video %>%
group_by(Year) %>%
        summarise(Total = sum(VIDEO_VIEWS)) %>%
        select(Year, Total) %>% 
        na.omit() %>%
      ggplot(aes(as.factor(Year), Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Year", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Video Views by Quarter

g <- video %>%
group_by(Quarter) %>%
        summarise(Total = sum(VIDEO_VIEWS)) %>%
        select(Quarter, Total) %>% 
        na.omit() %>%
      ggplot(aes(Quarter, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Quarter", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Video Views by Month

g <- video %>%
group_by(Month) %>%
        summarise(Total = sum(VIDEO_VIEWS)) %>%
        select(Month, Total) %>% 
        na.omit() %>%
      ggplot(aes(Month, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Month", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Video Views by Day of Week

g <- video %>%
group_by(DOW) %>%
        summarise(Total = sum(VIDEO_VIEWS)) %>%
        select(DOW, Total) %>% 
        na.omit() %>%
      ggplot(aes(DOW, Total)) + 
      geom_bar(stat = "identity",width = 0.5, fill='black') + theme_minimal() +
      labs(x = "Day of the week", y = "Total") + 
      scale_y_continuous(labels = comma) +
      theme(legend.text = element_text(size = 10),
            legend.title = element_text(size = 10),
            axis.title = element_text(size = 10),
            axis.text = element_text(size = 10),
            axis.text.x = element_text(angle = 0, hjust = 1))
ggplotly(g)

Part 2: A Tale of Portfolios/Customer Segmentation

Donor RFM Analysis

Donor Lifetime Value

Part 3: The Path Forward: Activating Our Strategy